00010	ENTRY PREPARE;
00020	BEGIN "XPREPARE"
00030	
00040	DEFINE ⊂="COMMENT";	⊂ This package contains all of the procedures
00050	that are used to process the input to obtain data in a form suitable
00060	for use in the signature tables which, in turn are processed by a
00070	separate MAC package SIG.;
00080	
00100	⊂  MODIFIED WED 21ST AT 1600 HRS 1.FIX COUNT IN INSET 2.AVE←LOG R0;
00110	EXTERNAL REAL ARRAY A,B,C[0:256];
00120	EXTERNAL INTEGER ARRAY INRAW,INDAT,INSUB,INDIV,INCNT,INNAM[0:24];
00125	DEFINE LISSIZ="760";
00127	EXTERNAL INTEGER ARRAY LIST[0:LISSIZ];
00130	EXTERNAL INTEGER ARRAY SUMDAT[0:1536];
00140	EXTERNAL INTEGER M,N,P;
00150	EXTERNAL INTEGER MINK,MINLOC,MAXK,MAXLOC,SEGC,SEGMRK,STEPS,INFLAG;
00152	EXTERNAL FORTRAN REAL PROCEDURE ALOG10(REAL X);
00155	         INTEGER ARRAY DELDAT[0:24];
00160	
00170	PROCEDURE INSET;
00180	BEGIN
00190	IF INRAW[P]<INSUB[P] THEN INSUB[P]←INRAW[P];
00200	IF INDIV[P]<INRAW[P] THEN INDIV[P]←INRAW[P];
00220	⊂  INCNT[P]←INCNT[P]+1;
00270	END "INSET";
00280	
00290	
00300	REAL SX;INTEGER NC; ⊂  **** SX GIVES FREQ INCREMENT PER FFT POINT ;
00310	                    ⊂  **** NC IS THE NO OF FFT POINTS;
00320	DEFINE SPEC="C"      ;  ⊂ **** ARRAY FOR FFT;
00330	
00340	
00350	⊂ **** GLOBALS FOR PARAEX ;
00355	EXTERNAL REAL R0 ;
00360	EXTERNAL INTEGER NP,NZ,FP1,FP2,FZ ;
00365	EXTERNAL REAL NPA,NZA,FP1A,FP2A,FZA, LPE,HPE,AVE ;
00370	EXTERNAL INTEGER ARRAY FF[1:5] ; EXTERNAL REAL ARRAY AMP[1:5] ;
00380	REAL PROCEDURE BAL(INTEGER M);
00381	BEGIN REAL XX;
00382	   XX←M-((SPEC[M-1]-SPEC[M+1])/(SPEC[M-1]+SPEC[M]+SPEC[M+1]));
00383	   RETURN(XX);
00384	END "BAL";
00385	
00386	INTEGER PROCEDURE ABS(INTEGER M);
00387	 BEGIN IF M<0 THEN M←-M; RETURN(M) END ;
00390	
00400	⊂ **** GLOBAL PARAMETER RANGES. SET IN "MAIN" PROGRAMME;
00410	EXTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H,
00415	  INL,INH,NZRNG,  FP1L,FP1H,FP2L,FP2H,
00420	        ILPB,ILPC,  IHPB,IHPC   ;	
00425	⊂ THE PARA LIMITS ARE (DOUBLE CHECK)
00428	    F1=200/800  F2=700/2050  F3=2000/3200
00431	    NP=800/1500  NZRNG=NP+/-500 ?
00432	    FP1=1800/3200   FP2=3200/5000   LPE=300/450  HPE=2500/3000 ;
00433	⊂ **** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00434	⊂ SX←SF/(2.*NC),I1L←200./SX,P.I1H←800./SX+.5,I2L←700./SX;
00435	⊂ I2H←2050./SX+.5, I3L←1950./SX, I3H←3250./SX+.5; 
00437	⊂ INL←800./SX, INH←1500./SX+.5, NZRNG←500./SX+.5;
00438	⊂  FP1L←1800./SX, FP1H←3200./SX,FP2L←3200./SX+.5,FP2H←5000./SX+.5;
00439	⊂  ILPB←300./SX, ILPC←450./SX, IHPC←2500./SX, IHPB←3000./SX;
00440	
00441	 PROCEDURE F2DECI;
00442	⊂ **** DECIDE IF F2 CLOSE TO F1;
00443	⊂ ********* FIX TH & 12.(DBS) ONLY AFTER EXING I'S U'S AND A'S;
00444	
00445	BEGIN
00446	REAL SUML,SUMH,TH;  INTEGER I;
00447	
00448	TH←6.0 ;  SUML←0.;
00449	   FOR I←I2L STEP 1 UNTIL I1H DO  SUML←SUML+SPEC[I];
00450	   SUML←SUML/(I1H-I2L+1.0);
00451	
00452	   SUMH←0.; FOR I←I3L STEP 1 UNTIL I2H DO SUMH←SUMH+SPEC[I];
00453	              SUMH←SUMH/(I2H-I3L+1.0);
00454	
00455	     IF SUML>SUMH+TH+12.0  THEN FF[2]←FF[1]+1 ; 
00456	⊂ OUTSTR(NL&"SUML="&CVF(SUML)&"SUMH="&CVF(SUMH));
00457	END "F2DECI";
00458	
00459	
00460	
00461	 INTEGER PROCEDURE PEAK(INTEGER I1,I2);
00462	⊂ **** THIS PROCEDURE LOOKS AT A SECTION BETWEEN I1 & I2 AND LOCATES 
00463	            A PROPER PEAK;
00464	BEGIN
00465	  LABEL L1,L2; REAL YMX; INTEGER I,IX; 
00466	  YMX←-1000.0;
00467	  L1: FOR I←I1 STEP 1 UNTIL I2 DO
00468	       IF YMX<SPEC[I] THEN BEGIN YMX←SPEC[I]; IX←I END;
00469	       IF IX=I1 THEN   BEGIN
00470	          WHILE YMX>SPEC[I1+1] DO
00471	            BEGIN I1←I1+1; IF I1=I2 THEN GOTO L2; YMX←SPEC[I1] END;
00472	               GOTO L1 END;
00473	  IF IX=I2 THEN  BEGIN
00474	     WHILE YMX>SPEC[I2-1] DO
00475	      BEGIN I2←I2-1; IF I2=I1 THEN GOTO L2;
00476	        YMX←SPEC[I2] END; 
00477	            GO TO L1; END;
00478	     RETURN(IX);
00479	⊂  OUTSTR(NL&NL&"NO PROPER PEAKS IN NO="&CVS(N));L2: RETURN(IX);
00480	 END "PEAK";
00490	INTEGER I,J;
00500	PROCEDURE FORMANTS;
00510	⊂ ****  I1L,I1H,I2L,I2H,I3L,I3H DEFINE THE RANGES RES FORMANTS;
00520	⊂ **** SPEC[FFT,TIME]=SPECTRUM(GLOBAL);
00530	⊂ **** INTEGER FF[5]& REAL AMP[5] (GLOBAL);
00540	⊂ **** LOWER F2H LIMIT TO AVOID HIGH ENERGY F3,
00545	   CATCH PROPER F2 BY AMP COMPARISON;
00550	
00560	BEGIN
00570	 IF INFLAG=1 THEN BEGIN
00580	INNAM[P]←LIST[P]←CVSIX("F1"); INNAM[P+1]←LIST[P+1]←CVSIX("F2");P←P+2;
00590	INNAM[P]←LIST[P]←CVSIX("F3");INNAM[P+1]←LIST[P+1]←CVSIX("A1");P←P+2;
00600	INNAM[P]←LIST[P]←CVSIX("A2");
00602	INNAM[P+1]←LIST[P+1]←CVSIX("A3"); P←P+2;
00605	  END ELSE BEGIN
00610	  INTEGER I;⊂ EXTERNAL INTEGER PROCEDURE PEAK(INTEGER I1,I2);
00620	⊂  EXTERNAL PROCEDURE  F2DECI;
00630	  FF[1]←PEAK(I1L,I1H);
00640	  FF[2]←PEAK(I2L,I2H);
00650	  FF[3]←PEAK(I3L,I3H);
00660	  IF FF[1]=FF[2] THEN FF[2]←PEAK(I1H,I2H); 
00670	  ⊂ **** F2DECI ON SPECTRAL BALANCE  ;
00680	⊂  IF SPEC[FF[2]]+6.0<SPEC[FF[3]] THEN BEGIN FF[2]←FF[3] ;
00690	⊂                                      FF[3]←PEAK(FF[3],I3H)  END  ; 
00700	
00710	  IF FF[2]=FF[3]  THEN FF[3]←PEAK(FF[3],I3H) ;
00720	⊂  FF[4]←PEAK(I1H,I3L);
00730	⊂  FF[5]←PEAK(I3H,I3H+10);
00740	   FOR I←1 STEP 1 UNTIL 3 DO
00750	     AMP[I]←SPEC[FF[I]];
00780	INDAT[P]←(FF[1]*7)-20; P←P+1;
00790	INDAT[P]←(FF[2]*3.7)-30; P←P+1;
00800	INDAT[P]←(FF[3]*3.7)-90; P←P+1;
00810	INDAT[P]←(AMP[1]*1.7)+18; P←P+1;
00820	INDAT[P]←(AMP[2]*2)+15; P←P+1;
00830	INDAT[P]←(AMP[3]*3.2)+15; P←P+1;
00840	
00850	
01000	END;
01010	END "FORMANTS";
01210	
01220	
01230	
01240	PROCEDURE FRINAS  ;  BEGIN
01250	 IF INFLAG=1 THEN BEGIN
01260	INNAM[P]←LIST[P]←CVSIX("FP1");
01265	INNAM[P+1]←LIST[P+1]←CVSIX("FP1A");P←P+2;
01270	INNAM[P]←LIST[P]←CVSIX("FP2")
01272	;INNAM[P+1]←LIST[P+1]←CVSIX("FP2A");P←P+2;
01275	INNAM[P]←LIST[P]←CVSIX("FZ");
01277	INNAM[P+1]←LIST[P+1]←CVSIX("FZA");P←P+2;
01280	INNAM[P]←LIST[P]←CVSIX("NP");
01285	INNAM[P+1]←LIST[P+1]←CVSIX("NPA");P←P+2;
01290	INNAM[P]←LIST[P]←CVSIX("NZ");
01292	 INNAM[P+1]←LIST[P+1]←CVSIX("NZA"); P←P+2;  END ELSE BEGIN
01295	⊂ EXTERNAL INTEGER PROCEDURE PEAK(INTEGER I1,I2);
01300	NP←PEAK(INL,INH);  FP1←PEAK(FP1L,FP1H);  FP2←PEAK(FP2L,FP2H);
01305	FP1A←SPEC[FP1]; FP2A←SPEC[FP2]; NPA←SPEC[NP];
01310	  BEGIN "ZEROS" REAL XNZ; INTEGER STP,JX,J;
01320	        STP←(NZRNG)/ABS(NZRNG);  XNZ←10000.;
01330	        FOR J←NP STEP STP UNTIL NP+NZRNG DO 
01340	            IF XNZ>SPEC[J] THEN BEGIN XNZ←SPEC[J]; JX←J  END;
01350	        NZ←JX;  NZA←SPEC[NZ];   XNZ←10000.;
01360	     FOR J←FP1 STEP 1 UNTIL FP2  DO 
01370	          IF XNZ>SPEC[J] THEN BEGIN XNZ←SPEC[J]; JX←J  END;
01380	        FZ←JX;  FZA←SPEC[FZ];
01390	  END "ZEROS";
01391	INDAT[P]←(FP1*3.8)-86; P←P+1;
01393	INDAT[P]←(FP1A*3.3)+15; P←P+1;
01395	INDAT[P]←(FP2*2.4)-90; P←P+1;
01397	INDAT[P]←(FP2A*3)+27; P←P+1;
01399	INDAT[P]←(FZ*3)-97; P←P+1;
01401	INDAT[P]←(FZA*4.4)+55; P←P+1;
01403	INDAT[P]←(NP*6.3)-60; P←P+1;
01405	INDAT[P]←(NPA*2.1)+19; P←P+1;
01407	INDAT[P]←(NZ*6)-83; P←P+1;
01409	INDAT[P]←(NZA*4.5)+45; P←P+1;
01411	
01413	
01419	END;
01424	END "FRINAS";
01430	PROCEDURE SEGPAR;
01440	BEGIN "SEGPAR"
01450	 IF INFLAG=1 THEN BEGIN
01460	INNAM[P]←LIST[P]←CVSIX("LPE");
01465	INNAM[P+1]←LIST[P+1]←CVSIX("AVE");P←P+2;
01470	  INNAM[P]←LIST[P]←CVSIX("HPE"); P←P+1; END ELSE BEGIN
01480	INTEGER J,K;
01490	⊂ *****  COMPUTE LOW-PASS POWER ;
01500	   LPE←0.0;
01510	     FOR J←1 STEP 1 UNTIL ILPB DO
01520	         LPE←LPE+SPEC[J];
01530	      
01540	     K←ILPC-ILPB;
01550	     FOR J←ILPB+1 STEP 1 UNTIL ILPC DO LPE←LPE+(SPEC[J]*(ILPC-J)/K);
01560	     LPE←LPE/ILPC;
01570	
01580	⊂ ***** COMPUTE HIGH-PASS POWER;
01590	
01600	   HPE←0.0; K←IHPB-IHPC;
01610	     FOR J←IHPC STEP 1 UNTIL IHPB-1 DO HPE←HPE+(SPEC[J]*(J-IHPC)/K);
01620	     FOR J←IHPB STEP 1 UNTIL NC DO HPE←HPE+SPEC[J];
01630	         HPE←HPE/(NC-IHPC);
01640	
01650	⊂ ***** COMPUTE AVERAGE POWER;
01660	     AVE←0.0;
01670	AVE←5.*ALOG10(R0);
01675	   R0←AVE; ⊂   FOR J←0 STEP 1 UNTIL NC DO AVE←AVE+SPEC[J];
01680	⊂       AVE←AVE/NC*R0;  HPE←HPE*R0;  ⊂ TO IMPROVE HPE SPREAD ;
01681	INDAT[P]←(LPE*3)+27; P←P+1;
01686	INDAT[P]←(AVE*4.3)-84; P←P+1;
01688	INDAT[P]←(HPE*0.7)+95; P←P+1;
01690	END;
01700	END "SEGPAR";
01710	
     

00020	
00030	INTERNAL PROCEDURE PREPARE;
00040	BEGIN
00200	
00250	P←0;
00275	  ⊂ Each procedure puts results in sequential locations in INRAW[P]
00300	and calls INSET which computes corresponding values INDAT[P]
00325	and updates P;
00350	P←0; NC←N;
00400	FOR I←0 STEP 1 UNTIL 24 DO DELDAT[I]←INDAT[I];
00450	FORMANTS;
00500	FRINAS;
00550	SEGPAR;	
00555	   IF INFLAG=1 THEN BEGIN
00560	      INNAM[P]←LIST[P]←CVSIX("TRVO"); P←P+1;
00565	      INNAM[P]←LIST[P]←CVSIX("TRAN"); P←P+1; END ELSE
00570	BEGIN  REAL SUM;
00600	FOR I←0 STEP 1 UNTIL P DO BEGIN
00650	    IF INDAT[I]>63 THEN INDAT[I]←63 ;
00700	    IF INDAT[I]<0  THEN INDAT[I]←0  ;
00750				  END;
00800	
00805	SUM←0.;⊂  FOR I←0 STEP 1 UNTIL 5 DO SUM←SUM+ABS(INDAT[I]-DELDAT[I]);
00810	⊂ SUM←SUM+ABS(INDAT[16]-DELDAT[16])+ABS(INDAT[17]-DELDAT[17]);
00815	 INDAT[P]←SUM;⊂ INDAT[P]←SUM-20.;⊂ INRAW[P]←SUM;⊂ INSET; P←P+1;
00820	
00825	SUM←0.;
00827	⊂  FOR I←0 STEP 1 UNTIL 18 DO SUM←SUM+ABS(INDAT[I]-DELDAT[I]);
00830	INDAT(P]←SUM;⊂   INDAT[P]←(SUM-70.)*63./110.;
00835	⊂  INRAW[P]←SUM;⊂  INSET; P←P+1;
00840	 IF INDAT[19]>63 THEN INDAT[19]←63;IF INDAT[19]<0 THEN INDAT[19]←0;
00845	IF INDAT[20]>63 THEN INDAT[20]←63;IF INDAT[20]<0 THEN INDAT[20]←0;
00850	END;
00855	END;
00900	END "XPREPARE";
00950